home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
INTERUPT
/
INTERU
/
CURSORS.PAS
next >
Wrap
Pascal/Delphi Source File
|
1988-03-10
|
3KB
|
132 lines
{$R-,S-,I-,D-,T-,F-,V-,B-,N-}
unit Cursors;
{ A unit for changing the appearance of the display cursor.
Version 1.02 - 10/26/1987 - First general release
Scott Bussinger
Professional Practice Systems
110 South 131st Street
Tacoma, WA 98444
(206)531-8944
Compuserve 72247,2671 }
interface
uses Dos;
type CursorSize = word;
CursorType = (UnderlineCursor,BlockCursor,NoCursor,RestoreCursor);
procedure GetCursor(var Curs: CursorSize);
{ Get the current cursor size }
procedure SetCursor(Curs: CursorSize);
{ Set the current cursor size }
procedure MakeCursor(CursType: CursorType);
{ Set the cursor to the indicated style -- adjusts for display type }
procedure GetCursorLoc(var Row,Column: byte);
{ Return the current cursor location }
procedure SetCursorLoc(Row,Column: byte);
{ Move the cursor to the given location }
function MonoDisplay: boolean;
{ Return true if the current display is a monochrome adapter }
implementation
var ExitSave: pointer;
OriginalCursor: CursorSize;
function MonoDisplay: boolean;
{ Return true if the current display is a monochrome adapter }
var Reg: Registers;
begin
Reg.AH := $0F;
Intr($10,Reg);
MonoDisplay := Reg.AL = 7
end;
procedure GetCursor(var Curs: CursorSize);
{ Get the current cursor size }
var Reg: Registers;
begin
Reg.AH := $03;
Reg.BH := $00;
Intr($10,Reg);
if (Reg.CX=$0607) and MonoDisplay
then
Curs := $0C0D { Watch out for bug in DOS }
else
Curs := Reg.CX
end;
procedure SetCursor(Curs: CursorSize);
{ Set the current cursor size }
var Reg: Registers;
begin
Reg.AH := $01;
Reg.CX := Curs;
Intr($10,Reg)
end;
procedure MakeCursor(CursType: CursorType);
{ Set the cursor to the indicated style -- adjusts for display type }
var LastLine: CursorSize;
begin
if MonoDisplay
then
LastLine := $000D
else
LastLine := $0007;
case CursType of
UnderlineCursor: SetCursor(swap(pred(LastLine)) + LastLine);
BlockCursor: SetCursor(LastLine);
NoCursor: SetCursor($2000);
RestoreCursor: SetCursor(OriginalCursor)
end
end;
procedure GetCursorLoc(var Row,Column: byte);
{ Return the current cursor location }
var Reg: Registers;
begin
Reg.AH := $03;
Reg.BH := $00;
Intr($10,Reg);
Row := succ(Reg.DH);
Column := succ(Reg.DL)
end;
procedure SetCursorLoc(Row,Column: byte);
{ Move the cursor to the given location }
var Reg: Registers;
begin
Reg.AH := $02;
Reg.BH := $00;
Reg.DL := pred(Column);
Reg.DH := pred(Row);
Intr($10,Reg)
end;
{$F+}
procedure ExitHandler;
{ Return the cursor to its original shape }
begin
MakeCursor(RestoreCursor);
ExitProc := ExitSave
end;
{$F-}
begin
ExitSave := ExitProc;
ExitProc := @ExitHandler;
GetCursor(OriginalCursor)
end.